Amiga Collections: Taifun/Taifun 099 (1989-05-15)(Ossowski, Stefan)(DE)(PD).zip/Taifun 099 (1989-05-15)(Ossowski, Stefan)(DE)(PD).adf/PCQ/Examples/Snow.p

Text File | 1989-03-31 | 5KB | 195 lines

Program Snowflake;

{ This program draws a fractal snowflake pattern.  I think I got it out
of some magazine years ago.  It was written, as I remember it, for the
PC in BASIC, which I converted to AmigaBASIC.  I have long since
forgotten the details of how it worked, so I could not give the
variables meaningful names.  To the original author, by the way, goes
the credit for those names.  Invoke the program with the line "Snow
<level>", where <level> is a digit between 1 and 6.  In order to get a
feel for what's going on, try running the levels in order.  Level 6
takes a long time, and frankly doesn't look as good as level 5.  }

{$I "Include/Intuition.i" for the windows }
{$I "Include/Math.i" for the basic floating point stuff }
{$I "Include/Mathtrans.i" for sin, cos, and sqrt}
{$I "Include/Graphics.i" for move() and draw() }
{$I "Include/Exec.i" just for OpenLibrary and CloseLibrary }
{$I "Include/Ports.i" for GetMsg and WaitPort }

var
    dx : array [0..11] of real;
    dy : array [0..11] of real;
    sd : array [0..6] of integer;
    rd : array [0..6] of integer;
    sn : array [0..6] of integer;
    ln : array [0..6] of real;
    a  : real;
    nc : integer;
    x, y, t : real;
    w  : WindowPtr;
    rp : RastPortPtr;
    n  : integer;
    d, ns, i, j : integer;
    l : real;
    rcon133, rcon05 : real;
    m : MessagePtr;

Procedure usage;
begin
    writeln('Usage: Snow <level>');
    writeln('       where <level> is between 1 and 6');
    exit(20);
end;

Function readcycles(): integer;
var
    index : integer;
    cycles : integer;
begin
    index := 1;
    while ((commandline[index] = ' ') or (commandline[index] = chr(9))) and
    (index < 128) do
    index := index + 1;
    if index >= 128 then
    usage;
    cycles := ord(commandline[index]) - ord('0');
    if (cycles > 6) or (cycles < 1) then
    usage;
    readcycles := cycles;
end;

Function OpenTheWindow() : Boolean;
var
    nw : NewWindowPtr;
begin
    new(nw);

    nw^.LeftEdge := 0;
    nw^.TopEdge := 0;
    nw^.Width := 640;
    nw^.Height := 200;

    nw^.DetailPen := -1;
    nw^.BlockPen  := -1;
    nw^.IDCMPFlags := CLOSEWINDOW_f;
    nw^.Flags := WINDOWDEPTH_f + WINDOWCLOSE_f + SMART_REFRESH_f + ACTIVATE_f;
    nw^.FirstGadget := nil;
    nw^.CheckMark := nil;
    nw^.Title := "Fractal Snowflake";
    nw^.Screen := nil;
    nw^.BitMap := nil;
    nw^.MinWidth := 50;
    nw^.MaxWidth := -1;
    nw^.MinHeight := 20;
    nw^.MaxHeight := -1;
    nw^.WType := WBENCHSCREEN_f;

    w := OpenWindow(nw);
    dispose(nw);
    OpenTheWindow := w <> nil;
end;

procedure initarrays;
begin
    sd[0] := 0;
    rd[0] := 0;
    sd[1] := 1;
    rd[1] := 0;
    sd[2] := 1;
    rd[2] := 7;
    sd[3] := 0;
    rd[3] := 10;
    sd[4] := 0;
    rd[4] := 0;
    sd[5] := 0;
    rd[5] := 2;
    sd[6] := 1;
    rd[6] := 2;

    for n := 0 to 6 do
    ln[n] := spdiv(spfloat(1), spfloat(3));
    ln[2] := spsqrt(ln[1]);
    a := spfloat(0);
    for n := 6 to 11 do begin
    dy[n] := spsincos(dx[n], a);
        a := spadd(a, spdiv(spfloat(52359), spfloat(100000)));
    end;
    for n := 0 to 5 do begin
    dx[n] := spneg(dx[n + 6]);
    dy[n] := spneg(dy[n + 6]);
    end;
    x := spfloat(534);
    y := spfloat(151);
    t := spfloat(324);
    rcon133 := spdiv(spfloat(4), spfloat(3));
    rcon05  := spdiv(spfloat(1), spfloat(2));
end;

begin
    nc := readcycles();
    if not OpenMathTrans() then begin
    writeln('Could not open MathTrans.library.');
    exit(20);
    end;
    initarrays;

    GfxBase := OpenLibrary("graphics.library", 0);
    if GfxBase = nil then begin
    writeln('Could not open Graphics.library');
    FlushMathTrans;
    exit(20);
    end;

    if OpenTheWindow() then begin
    rp := w^.RPort;

    for n := 0 to nc do
        sn[n] := 0;

    Move(rp, spfix(x), spfix(y));

    repeat
        d := 0;
        l := t;
        ns := 0;

        for n := 1 to nc do begin
        i := sn[n];
        l := spmul(l, ln[i]);
        j := sn[n - 1];
        ns := ns + sd[j];
        if odd(ns) then
            d := (d + 12 - rd[i]) mod 12
        else
            d := (d + rd[i]) mod 12;
        end;

        { x := x + 1.33 * l * dx[d]; }
        x := spadd(x, spmul(spmul(rcon133, l), dx[d]));

        { y := y - 0.5 * l * dy[d]; }
        y := spsub(y, spmul(spmul(l, dy[d]), rcon05));

        Draw(rp, spfix(x), spfix(y));
        sn[nc] := sn[nc] + 1;
        n := nc;
        while (n >= 1) and (sn[n] = 7) do begin
        sn[n] := 0;
        sn[n - 1] := sn[n - 1] + 1;
        n := n - 1;
        end;
    until sn[0] <> 0;
    m := WaitPort(w^.UserPort);
    forbid;
    repeat
        m := GetMsg(w^.UserPort);
    until m = nil;
    permit;
    CloseWindow(w);
    end else
    writeln('Could not open the window');
    CloseLibrary(GfxBase);
    FlushMathTrans;
end.